home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / Utilmod.txt < prev    next >
Encoding:
Text File  |  1995-07-06  |  1.8 KB  |  82 lines  |  [TEXT/MSET]
  1. \ Various utilities
  2.  
  3.  
  4. \ Class RES+ adds methods to Resource to allow various modifications
  5. \ to resources.  We'll put more in as we need them.
  6.  
  7. : CHK    word0  call reserror  i->l  ?dup  0EXIT
  8.     ." resource error# " .  ;
  9.  
  10.  
  11. :class    RES+    super(    resource  )
  12.  
  13. :m CHANGED:
  14.     get: self  call ChangedResource  ;m
  15.  
  16. :m ADD:  { addr len -- }
  17.     get: self
  18.     get: resType  get: ID  makeint
  19.     addr len str255  call AddResource  chk  ;m
  20.  
  21. :m REMOVE:
  22.     get: self  call RmveResource  chk  ;m
  23.  
  24. :m SETATTRS:    \ ( n -- )
  25.     get: self  swap  makeint  call SetResAttrs  chk
  26.     changed: self  ;m
  27.  
  28. ;class
  29.  
  30.     string    TEMP$
  31.     res+    TEMPRES
  32.  
  33.  
  34. : (.MOD)  { theCfa size \ modObj -- }
  35.     theCfa  mod? NIF  drop  EXIT  THEN
  36.     >obj  -> modObj
  37.     cr  0 -> out  .id: [ modObj ]
  38.     15 out -  spaces
  39.     base: [ modObj ]  dup
  40.     NIF  drop  ." not loaded"  ELSE  u.h  THEN
  41.     keep?: [ modObj ]    IF  type# 174 ( *** Keep *** )  THEN
  42.     locked?: [ modObj ]    IF  type# 175 ( *** Locked *** )  THEN  ;
  43.  
  44. : .MODS        \ Lists modules and their load status.
  45.     curs  -curs
  46.     ['] (.mod)  0 trav
  47.     -> curs cr ;     \ 31Jan94 DBH   End with a cr   Better for TW
  48.  
  49.  
  50. : .MSGS        \ Lists all error etc. messages and their numbers.
  51.     300 -60  DO
  52.         ?pause cr
  53.         i . space  i  getstring
  54.         dup IF  type  ELSE  2drop  THEN
  55.     LOOP  ;
  56.  
  57.  
  58. : ADDMSG  { msg# addr len -- }
  59.     msg# getstring  abort" number already assigned"  drop
  60.     addr  pad 1+  len  cmove
  61.     len pad c!
  62.     new: temp$
  63.     pad  len 1+  put: temp$
  64.     'type STR   msg#  set: tempRes  handle: temp$  put: tempRes
  65.     0 0  add: tempRes
  66.     $ 20  setAttrs: tempRes  ;
  67.  
  68. : REMOVEMSG  { msg# -- }
  69.     msg# getstring  nip  0EXIT
  70.     'type STR   msg#  set: tempRes  getnew: tempRes
  71.     remove: tempRes  release: tempRes  ;
  72.  
  73.  
  74. : GETINDSTR  { resID idx \ addr -- addr len }
  75.     openMR
  76.     'type STR#  resID  getRes  dup NIF  0  EXIT  THEN
  77.     ( handle )  @  -> addr
  78.     idx  addr w@  >=  IF  0 0  EXIT  THEN
  79.     2 ++> addr
  80.     idx 0 ?DO  addr count +  -> addr  LOOP
  81.     addr count  ;
  82.